home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / MEDICAL / 2608A.ZIP / BUGFIXGP.ZIP / 3YRLABCD.SRC next >
Text File  |  1990-11-21  |  11KB  |  591 lines
  1. ;\|
  2. ;3YRLABCD.SRC     Translated from 3YRLABCD.EDT by Roger Mathew's EDT2SRC Ver 4.11
  3. ;START    01:33:20 PM  21/ 6/90   |
  4. RECALLSX:
  5. define(Z30|A|30||)
  6. define(YES.NO|A|1||)
  7. define(CHK_FLD|N|8||)
  8. define(NUM_N|N|2||)
  9. define(NUM|A|2||)
  10. define(DATE_A|A|8||)
  11. define(DATE_B|A|10||)
  12. define(TO_DATE|S|8||)
  13. define(WAIT|N|3||)
  14. define(MEM_AD|A|22||)
  15. define(SENT_DATE|S|8||)
  16. define(CHK_DATE|S|8||)
  17. define(PUNC2|N|2||)
  18. define(CH_NAME|A|15||)
  19. define(HIS|A|3||)
  20. define(CLIN_DAY|A|25||)
  21. define(CLIN_TIME|A|10||)
  22. define(CNTR|N|2||)
  23. define(FLAG|A|1||)
  24. define(AMOUNTX|N|4||)
  25. define(S10|A|10||)
  26. define(DATECOD|S|8||)
  27. define(CODER|A|5||)
  28. define(C30|A|30||)
  29. define(TM|A|27||4)
  30. define(A30|A|30||)
  31. define(CHOICE|N|1||)
  32. define(TDND|S|8||)
  33. define(DATERP|S|8||)
  34. define(B30|A|30||)
  35. define(S1|A|1||)
  36. define(TD|S|8||)
  37. define(A8|A|8||)
  38. define(B8|A|8||)
  39. define(YES.NO|A|1||)
  40. define(N5|N|5||)
  41. define(D1|A|1||)
  42. define(NY|A|1||)
  43. define(CODEX1|S|8||)
  44. define(CTR|N|2||)
  45. define(DATEN|N|2||)
  46. define(DATEX|S|8||)
  47. define(ARRAY1|A|30||3)
  48. define(ARRAY2|A|22||3)
  49. define(ARRAY3|A|22||3)
  50. define(ARRAY4|A|4||3)
  51. define(ARRAY5|S|8||3)
  52. define(TIT|A|4||)
  53. define(PATIENT1A|A|30||)
  54. define(PUNC1|N|2||)
  55. define(N.2.0.P|N|2||)
  56. define(P.2.0.1|N|2||)
  57. define(P.2.0.2|N|2||)
  58. define(PATIENT2|A|30||)
  59. define(P.2.0.3|N|2||)
  60. define(RECTYPE1|A|4||)
  61. define(RECTYPE2|A|4||)
  62. define(PATIENT1|A|30||)
  63. define(DOB1|D|10||)
  64. define(DOB2|D|10||)
  65. STARTREC:
  66. open(PATIENT||0|FILE_LOCK)
  67. open(GPSETUP||0|)
  68. find(B|HEADING||)
  69. D1 = ("")
  70. date(TD|G)
  71. YES.NO = ("")
  72. DATEX = (0)
  73. CODEX1 = (0)
  74. NY = ("")
  75. trap(I|G|PRINTSTOP)
  76. trap(S|I)
  77. trap(D|I)
  78. trap(F|I)
  79. trap(R|I)
  80. trap(B|I)
  81. trap(G|I)
  82. trap(H|S|HELP)
  83. trap(M|I)
  84. trap(N|I)
  85. trap(Q|G|MENU)
  86. trap(J|G|LASTSEEN)
  87. goto LASTSEEN
  88. mount(RECALLS|S)
  89. enter(RECTYPE1||||Y|Y|N|||N)
  90. enter(RECTYPE2||||Y|Y|N|||N)
  91. enter(CTR|"123456789"|||N|Y|N|||N)
  92. enter(CODEX1|||RECALLSX|N|Y|N|||N)
  93. DATEXX:
  94. NY = ("")
  95. enter(YES.NO|"YN"|||Y|Y|N|||N)
  96. CODEX1:
  97. RECSTART:
  98. COD.PAT.NAME = ("A")
  99. find(G|COD.PAT.NAME|EXIT|N)
  100. RECTEST:
  101. if COD[CTR] = ("HYS") goto NEXTRECALL
  102. if COD[CTR] = ("VIR") goto NEXTRECALL
  103. if COD[CTR] = ("REF") goto NEXTRECALL
  104. if COD[CTR] = ("MOV") goto NEXTRECALL
  105. if RECTYPE1 <> ("") then if RECTYPE1 > (COD[CTR]) goto NEXTRECALL
  106. if RECTYPE2 <> ("") then if RECTYPE2 < (COD[CTR]) goto NEXTRECALL
  107. if COD.D[CTR] > (CODEX1) goto NEXTRECALL
  108. if COD.D[CTR] = (0) goto NEXTRECALL
  109. RECORD.NUMBER = (COD.REF)
  110. DATECOD = (COD.D[CTR])
  111. CODER = (COD[CTR])
  112. find(M|RECORD.NUMBER|EXIT|)
  113. DATERP = (COD.D[CTR])
  114. if NY = ("") do
  115. {
  116. gosub PRINTRECAL
  117. }
  118. else
  119. {
  120. gosub RECLABPRIN
  121. }
  122. NEXTRECALL:
  123. find(N|RECALLS|EXITX|)
  124. goto RECTEST
  125. MOUNTRECAL:
  126. mount(RPLABELS|R|P)
  127. pchr(P|10)
  128. pchr(P|11)
  129. pchr(P|4)
  130. pchr(P|1)
  131. pset(132|66|60)
  132. trap(I|G|PRINTSTOP)
  133. trap(P|S|RECHEAD)
  134. AMOUNTX = (0)
  135. gosub RECHEAD
  136. ret
  137. PRINTRECAL:
  138. pfmt(18|||N|N|)
  139. AMOUNTX = (AMOUNTX+1)
  140. DATECOD = (0)
  141. CODER = ("")
  142. ret
  143. RECHEAD:
  144. pfmt(16|||N|N|)
  145. pfmt(17|||N|N|)
  146. ret
  147. RECALLS:
  148. trap(P|D)
  149. ptof
  150. if D1 = ("X") then goto RECALLSX
  151. if YES.NO = ("Y") do
  152. {
  153. gosub RECLABS
  154. }
  155. else
  156. {
  157. goto RECALLSX
  158. }
  159. goto RECSTART
  160. TOPOF:
  161. ptof
  162. ret
  163. RECLABS:
  164. NY = ("X")
  165. trap(P|D)
  166. trap(I|S|PRINTSTOP)
  167. pchr(P|4)
  168. mount(NEW|R|P)
  169. pset(50|18|18)
  170. D1 = ("X")
  171. ret
  172. PRINT_LAB:
  173. pblnk(4)
  174. pfmt(1|||N|N|)
  175. pblnk(2)
  176. pfmt(2|||N|N|)
  177. pblnk(2)
  178. pfmt(3|||N|N|)
  179. pblnk(4)
  180. if FLAG = ("X") goto EXIT
  181. ret
  182. CL_ARRAY:
  183. clrmem(ARRAY1|3)
  184. clrmem(ARRAY2|3)
  185. clrmem(ARRAY3|3)
  186. clrmem(ARRAY4|3)
  187. clrmem(ARRAY5|3)
  188. ret
  189. RECLABPRIN:
  190. gosub SEXIST
  191. gosub NEWX
  192. NY = ("X")
  193. DATECOD = (0)
  194. CODER = ("")
  195. CNTR = (CNTR+1)
  196. ARRAY1[CNTR] = (Z30)
  197. ARRAY2[CNTR] = (ADDRESS1)
  198. ARRAY3[CNTR] = (AREA)
  199. ARRAY4[CNTR] = (COD[CTR])
  200. ARRAY5[CNTR] = (COD.D[CTR])
  201. if CNTR = (3) gosub PRINT_LAB
  202. ret
  203. EXITX:
  204. if NY <> ("") do
  205. {
  206. CNTR = (2)
  207. FLAG = ("X")
  208. gosub RECLABPRIN
  209. }
  210. goto RECALLS
  211. REPONLY:
  212. run("REPONLY")
  213. SEXIST:
  214. if SEX = ("M") then TIT = ("Mr.")
  215. if SEX = ("F") do
  216. {
  217. if MARITAL.STATUS = ("M") do
  218. {
  219. TIT = ("Mrs.")
  220. }
  221. else
  222. {
  223. TIT = ("Ms.")
  224. }
  225. }
  226. if SEX = ("") then TIT = ("Ms.")
  227. trim(TIT|T)
  228. ret
  229. NEWX:
  230. NY = (" ")
  231. PATIENT1A = (PATIENT.NAME)
  232. trim(PATIENT1A|T)
  233. PUNC1 =loc(","|PATIENT1A|1||27)
  234. N.2.0.P =siz(A|PATIENT.NAME)
  235. P.2.0.1 = (PUNC1-1)
  236. PATIENT2 =mid(PATIENT.NAME|1|P.2.0.1|)
  237. P.2.0.2 = (PUNC1+2)
  238. P.2.0.3 = (N.2.0.P-P.2.0.2+1)
  239. PATIENT1 =mid(PATIENT1A|P.2.0.2|P.2.0.3|)
  240. trim(PATIENT1|T)
  241. trim(PATIENT2|T)
  242. Z30 = (TIT+PATIENT1+NY+PATIENT2)
  243. ret
  244. CLEARALL:
  245. clr(PATIENT|B)
  246. clr(RECALLS|B)
  247. S1 = ("")
  248. DATEX = (0)
  249. YES.NO = ("")
  250. ret
  251. EXIT:
  252. run("recmenu")
  253. EXIT1:
  254. run("recmenu")
  255. PRINTSTOP:
  256. pon(S)
  257. clrlne(1|25)
  258. pmsg("CONTINUE ? (Y/N):"|30|12|N|N|S|)
  259. enter(YES.NO|"YN"||PRINTSTOP|Y|Y|N|48|12|N)
  260. if YES.NO <> ("Y") then run("recmenu")
  261. pon(P)
  262. ret
  263. MENU:
  264. TM[1] = (" 1 - EXIT             01011")
  265. menu(1|20|2|23|0|TM|CHOICE|1|22|MENU||"-------RECALLS--------"|N)
  266. on(CHOICE|G|EXIT1|MENU)
  267. TRACE:
  268. break
  269. ret
  270. FILE_LOCK:
  271. pmsg("FILE PATIENT AND/OR RECALLS IS IN USE - EXIT"|20|24|Y|N|S|)
  272. clrlne(1|24)
  273. run("recmenu")
  274. HELP:
  275. saves(1)
  276. window(1|23|22|78)
  277. pmsg("                                    SMEAR RECALLS"|1|1|N|Y|S|)
  278. pmsg("                                    ============="|1|2|N|Y|S|)
  279. pmsg("1.USE UPDATE PROGRAM AND MAKE SURE ALL WOMEN BETWEEN 33 AND 65 ARE ENTERED"|1|3|N|Y|S|)
  280. pmsg("2.ALL THESE WOMEN MUST HAVE A RECALL DATE."|1|4|N|Y|S|)
  281. pmsg("3.RUN REPORT ONLY TO GET LATEST UPDATE ON TOTAL AT-RISK GROUP"|1|5|N|Y|S|)
  282. pmsg("4.RECALL EVERY MONTH ON THE 16th + A DAY OR TWO"|1|6|N|Y||)
  283. pmsg("5.CHECK OFF AGAINST RECALL LIST. ALL NON-ATTENDERS WILL BE ASKED AGAIN"|1|7|N|Y|S|)
  284. pmsg("6.NON-ATTENDERS WILL BE THOSE WHO ARE MORE THAN ONE MONTH BEHIND"|1|8|N|Y||)
  285. pmsg(""|1|9|N|Y|S|)
  286. pmsg("                                    CODES"|1|10|N|Y|S|)
  287. pmsg("                                    ====="|1|11|N|Y|S|)
  288. pmsg("CODE 1 = SMEARS"|1|12|N|Y|S|)
  289. pmsg("CODE 2 = CONTRACEPTION"|1|13|N|Y|S|)
  290. pmsg("CODE 3 = IMMUNISATION"|1|14|N|Y|S|)
  291. pmsg("CODE 4 = DIABETES"|1|15|N|Y|S|)
  292. pmsg("CODE 5 = EPILEPSY"|1|16|N|Y|S|)
  293. pmsg("CODE 6 = THYROID"|1|17|N|Y|S|)
  294. pmsg("CODE 7 = ANGINA AND HEART DISEASE"|1|18|N|Y|S|)
  295. pmsg("CODE 8 = ASTHMA"|1|19|N|Y|S|)
  296. pmsg("CODE 9 = BP"|1|20|N|Y|S|)
  297. pmsg(""|1|21|Y|N|S|)
  298. redsp(1)
  299. ret
  300. LASTSEEN:
  301. trap(I|S|PRINTSTOP)
  302. trap(J|G|STARTREC)
  303. mount(LABS|S)
  304. MEM_AD = ("1")
  305. enter(MEM_AD||||Y|N|N|||N)
  306. enter(TO_DATE||||N|N|N|||N)
  307. enter(CHK_DATE||||N|N|N|||N)
  308. enter(DOB1||||N|N|N|||N)
  309. enter(DOB2||||N|N|N|||N)
  310. SENT_DATE = (TD)
  311. enter(YES.NO|"YN"|||Y|Y|N|||N)
  312. if YES.NO <> ("Y") goto LASTSEEN
  313. gosub RECLABS
  314. ADDRESS1 = (MEM_AD)
  315. find(G|ADDRESS1|EXIT|)
  316. TEST_SEEN:
  317. if DATE.OF.BIRTH < (DOB1) goto NEXT_SEEN
  318. if DATE.OF.BIRTH > (DOB2) goto NEXT_SEEN
  319. if DATE_SEEN > (SEEN) do
  320. {
  321. SEEN = (DATE_SEEN)
  322. save(PATIENT|N|N)
  323. find(M|ADDRESS1||)
  324. }
  325. if SEEN > (DATE_SEEN) do
  326. {
  327. DATE_SEEN = (SEEN)
  328. save(PATIENT|N|N)
  329. find(M|ADDRESS1||)
  330. }
  331. if SEEN < (CHK_DATE) do
  332. {
  333. if SENT_FOR > (TO_DATE - 365) goto NEXT_SEEN
  334. gosub PRINT_SEEN
  335. SENT_FOR = (SENT_DATE)
  336. save(PATIENT|N|N)
  337. find(M|ADDRESS1||)
  338. }
  339. NEXT_SEEN:
  340. find(N|PATIENT|EXITXX|)
  341. pmsg(RECORD.NUMBER|1|1|N|N|S|)
  342. goto TEST_SEEN
  343. PRINT_SEEN:
  344. gosub SEXIST
  345. gosub NEWX
  346. gosub SEEN_PRINT
  347. ret
  348. SEEN_PRINT:
  349. WAIT = (WAIT+1)
  350. if WAIT = (195) do
  351. {
  352. pmsg(WAIT;" printed - change cards and press ret..."|10|20|Y|N|S|)
  353. WAIT = (0)
  354. }
  355. pblnk(6)
  356. pfmt(1|||N|N|)
  357. pblnk(2)
  358. pfmt(2|||N|N|)
  359. pblnk(2)
  360. pfmt(3|||N|N|)
  361. pblnk(4)
  362. pfmt(4|||N|N|)
  363. ret
  364. EXITXX:
  365. goto EXIT
  366. \R RPLABELS
  367. &                                      &                                        &
  368. &                                      &                                        &
  369. &                                      &                                        &
  370.  
  371. &    &                                 &    &                                   &    &
  372.  
  373.  
  374.  
  375.  
  376.  
  377.  
  378.       &
  379.            &
  380.               &
  381.       &
  382. PATIENT                - RECALL REPORT- &                                        CODE (& )
  383. ------------------------------------------------------------------------------------------
  384. &                             &                     &                      (&    )&         &     [&]
  385.  
  386.  
  387.  
  388.  
  389.  
  390.  
  391.  
  392.  
  393.  
  394.  
  395.  
  396.  
  397.  
  398.  
  399.  
  400.  
  401.  
  402.  
  403.  
  404.  
  405.  
  406.  
  407.  
  408.  
  409.  
  410.  
  411.  
  412.  
  413.  
  414.  
  415. \
  416. ARRAY1[1]
  417. ARRAY1[2]
  418. ARRAY1[3]
  419. ARRAY2[1]
  420. ARRAY2[2]
  421. ARRAY2[3]
  422. ARRAY3[1]
  423. ARRAY3[2]
  424. ARRAY3[3]
  425. ARRAY4[1]
  426. ARRAY5[1]
  427. ARRAY4[2]
  428. ARRAY5[2]
  429. ARRAY4[3]
  430. ARRAY5[3]
  431. Z30
  432. ADDRESS1
  433. AREA
  434. DATERP
  435. TD
  436. CTR
  437. PATIENT.NAME
  438. ADDRESS1
  439. AREA
  440. CODER
  441. DATECOD
  442. AMOUNTX
  443. DOCTOR
  444. \
  445. \STRECALLS 
  446.  
  447.  
  448.  
  449.  
  450.                   YOU MAY JUMP TO PRINT "NOT SEEN" LABELS
  451.  
  452.       This will recall all recall code 1 except "HYS;VIR;MOV;REF;ETC"
  453.  
  454.                                    RECALLS
  455.                  ╔════════════════════════════════════════╗
  456.                  ║                                        ║
  457.                  ║  From Code:&     to  Code:&            ║
  458.                  ║                                        ║
  459.                  ║ Recall code:[& ]                       ║
  460.                  ║                                        ║
  461.                  ║ Up to Date:&                 Labels?:& ║
  462.                  ╚════════════════════════════════════════╝
  463.                F1 - Help   "Printer on for labels" Esc - Exit
  464.  
  465.  
  466.  
  467.  
  468.  
  469.  
  470. \
  471. RECTYPE1
  472. RECTYPE2
  473. CTR
  474. CODEX1
  475. YES.NO
  476. \
  477. \STNOTE    
  478.                          RECALLS - WHAT TO DO
  479.                          ====================
  480.  
  481. 1. TO TAG ALL POTENTIAL RECALLS ANSWER RUN RECALLS AT RISK FROM MAIN MENU.
  482.  
  483.   (THIS WILL TAG A GIVEN AGE GROUP WITH CODE <****>)
  484.  
  485. 2. TO UPDATE THE <****> USE EASY SMEAR /IMMUNISATION UPDATE PROGRAM.
  486.  
  487. 3. IF YOU ANSWER NO TO REPORT ONLY YOU WILL PRINT A LIST OF OUTSTANDING
  488.    RECALLS WITH OR WITHOUT LABELS.
  489.  
  490. 6. PRINT OUT THESE AND SEND TO PATIENTS.
  491.  
  492. 7. UPDATE  RESULTS USING EASY RECALL MAINTENANCE
  493.  
  494.         NOTE: THIS PROGRAM WILL ALWAYS PRINT OUT "ALL" OUTSTANDING RECALLS.
  495.  
  496.                           ========================
  497.  
  498.  
  499.  
  500.  
  501.  
  502. \
  503. \
  504. \STLABS    
  505.  
  506.  
  507.  
  508.  
  509.  
  510.  
  511.                   PRINTS ADDRESSES ON CARDS FOR 3 YEAR CHECK
  512.                    ╔═══════════════════════════════════════╗
  513.                    ║ From Address:&                        ║
  514.                    ║ Target Date :&          eg 01/04/91   ║
  515.                    ║ 3 years ago :&          eg 01/04/88   ║
  516.                    ║ From Dob 75 :&          eg 01/04/1914 ║
  517.                    ║ To Dob   16 :&          eg 01/04/1975 ║
  518.                    ║     CONTINUE:&                        ║
  519.                    ╚═══════════════════════════════════════╝
  520.                      REQUIRES CARDS IN PRINTER REVERSE SIDE
  521.                           Esc - Exit or stop printing
  522.  
  523.  
  524.  
  525.  
  526.  
  527.  
  528.  
  529. \
  530. MEM_AD
  531. TO_DATE
  532. CHK_DATE
  533. DOB1
  534. DOB2
  535. YES.NO
  536. \
  537. \R NEW     
  538.         &
  539.            &
  540.                &
  541. -
  542.  
  543.  
  544.  
  545.  
  546.  
  547.  
  548.  
  549.  
  550.  
  551.  
  552.  
  553.  
  554.  
  555.  
  556.  
  557.  
  558.  
  559.  
  560.  
  561.  
  562.  
  563.  
  564.  
  565.  
  566.  
  567.  
  568.  
  569.  
  570.  
  571.  
  572.  
  573.  
  574.  
  575.  
  576.  
  577.  
  578.  
  579.  
  580.  
  581.  
  582.  
  583.  
  584.  
  585.  
  586. \
  587. Z30
  588. ADDRESS1
  589. AREA
  590. \
  591.